home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / obero / oberon_lib.lha / oberon-a / source1.lha / source / ProjectOberon / Files.mod next >
Text File  |  1994-08-08  |  19KB  |  690 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Files.mod $
  4.   Description: Port of the Project Oberon Files module
  5.  
  6.    Created by: J. Gutknecht
  7.     Ported by: fjc (Frank Copeland)
  8.     $Revision: 1.6 $
  9.       $Author: fjc $
  10.         $Date: 1994/08/08 16:41:14 $
  11.  
  12.   Copyright © 1990-1993, ETH Zuerich
  13.   Copyright © 1994, Frank Copeland.
  14.   This file is part of the Oberon-A Library.
  15.   See Oberon-A.doc for conditions of use and distribution.
  16.  
  17.   Log entries are at the end of the file.
  18.  
  19. ***************************************************************************)
  20.  
  21. MODULE Files;
  22.  
  23. (*
  24.   Interface notes
  25.   ===============
  26.  
  27.   This module attempts to reproduce the behaviour of the Project Oberon
  28.   module as closely as possible, with two major exceptions.  AmigaDOS does
  29.   not allow multiple simultaneous access to a file.  Until I can work out
  30.   some way of recycling AmigaDOS FileHandles, only one user will be allowed
  31.   per file.  This implementation of Oberon does not include a resource
  32.   tracker.  This means that files must be explicitly closed, using either
  33.   Register (), Close () or Purge ().  File variables remain allocated after
  34.   calls to these procedures, but cannot be used again; they should be
  35.   explicitly de-allocated with SYSTEM.DISPOSE ().
  36.  
  37.   Implementation Notes
  38.   ====================
  39.  
  40.   This module is built as a layer on top of AmigaDOS.  Old() attempts to
  41.   open the named file with a read/write (but not exclusive) lock.  New()
  42.   creates a temporary file.  Both will fail if they attempt to open an
  43.   interactive file.  Register() deletes any existing file and renames the
  44.   temporary file.  Purge() deletes the file.  Register(), Close() and
  45.   Purge() explicitly close the AmigaDOS file but do not de-allocate the File
  46.   variable; this allows the programmer to check for any errors that occur
  47.   during the close operation.
  48.  
  49.   [TBD]
  50.  
  51. *)
  52.  
  53. (*
  54. ** $C= CaseChk       $I= IndexChk  $L= LongAdr   $N= NilChk
  55. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  56. ** $V= OvflChk       $Z= ZeroVars
  57. *)
  58.  
  59. IMPORT SYS := SYSTEM, Dos, DosUtil, Str := Strings, Oberon;
  60.  
  61.  
  62. (* --- Public declarations ---------------------------------------------- *)
  63.  
  64.  
  65. TYPE
  66.   File * = POINTER TO Handle;  (* Note that file.dosError is public. *)
  67.   Buffer = POINTER TO BufferRecord;
  68.  
  69.   Rider * = RECORD
  70.     eof * : BOOLEAN;
  71.     res * : LONGINT; (* Set to the error code returned by AmigaDOS *)
  72.     file  : File;
  73.     apos  : LONGINT;
  74.     buf   : Buffer;
  75.     bpos  : INTEGER;
  76.   END; (* Rider *)
  77.  
  78.  
  79. (* --- Private declarations and procedures ------------------------------ *)
  80.  
  81. (*
  82.   These definitions are taken from the Project Oberon module FileDir, which
  83.   does not exist in this implementation.
  84. *)
  85.  
  86.  
  87. CONST
  88.   FnLength = 256; (* for AmigaDOS, = 32 for Project Oberon *)
  89.   SectorSize = 1024;
  90.  
  91. TYPE
  92.   FileName = ARRAY FnLength OF CHAR;
  93.   DataSector = ARRAY SectorSize OF SYS.BYTE;
  94.  
  95.  
  96. (*------------------------------------*)
  97.  
  98.  
  99. CONST
  100.   MaxBufs = 4;
  101.  
  102. TYPE
  103.   DiskAdr = LONGINT;
  104.  
  105.   Handle = RECORD
  106.     len        : LONGINT;
  107.     nofbufs    : INTEGER;
  108.     firstbuf   : Buffer;
  109.     name       : FileName;
  110.     time, date : LONGINT;
  111.     fileHandle : Dos.FileHandlePtr;
  112.     dosError * : LONGINT;           (* The AmigaDOS error code for the most
  113.                                      * recent operation
  114.                                      *)
  115.     tempKey    : LONGINT;
  116.     next       : File;
  117.   END; (* Handle *)
  118.  
  119.   BufferRecord = RECORD
  120.     apos : LONGINT;
  121.     lim  : INTEGER;
  122.     mod  : BOOLEAN;
  123.     next : Buffer;
  124.     data : DataSector;
  125.   END; (* BufferRecord *)
  126.  
  127. VAR
  128.   tempKey : LONGINT; (* Used to generate temporary file names. *)
  129.   files : File;
  130.  
  131. (*------------------------------------*)
  132. PROCEDURE Unlink (f : File);
  133.  
  134.   VAR f0 : File;
  135.  
  136. BEGIN (* Unlink *)
  137.   IF f # NIL THEN
  138.     IF files # NIL THEN
  139.       IF f = files THEN
  140.         files := files.next
  141.       ELSE
  142.         f0 := files;
  143.         WHILE (f0.next # NIL) & (f0.next # f) DO
  144.           f0 := f0.next
  145.         END;
  146.         IF f0.next = f THEN f0.next := f.next END;
  147.       END;
  148.     END;
  149.     f.next := NIL
  150.   END;
  151. END Unlink;
  152.  
  153. (*------------------------------------*)
  154. PROCEDURE ReadBuf (f : File; buf : Buffer; pos : LONGINT);
  155.  
  156.   VAR res : LONGINT;
  157.  
  158. BEGIN (* ReadBuf *)
  159.   res := Dos.base.Seek (f.fileHandle, pos, Dos.offsetBeginning);
  160.   IF res # -1 THEN
  161.     (* ASSERT (buf # NIL, 137); *)
  162.     buf.lim := SHORT (Dos.base.Read (f^.fileHandle, buf.data, SectorSize));
  163.     buf.apos := pos;
  164.     buf.mod := FALSE;
  165.   ELSE
  166.     f.dosError := Dos.base.IoErr ()
  167.   END
  168. END ReadBuf;
  169.  
  170.  
  171. (*------------------------------------*)
  172. PROCEDURE WriteBuf (f : File; buf : Buffer);
  173.  
  174.   VAR res : LONGINT;
  175.  
  176. BEGIN (* WriteBuf *)
  177.   (* ASSERT (buf # NIL, 137); *)
  178.   res := Dos.base.Seek (f.fileHandle, buf.apos, Dos.offsetBeginning);
  179.   IF res # -1 THEN
  180.     res := Dos.base.Write (f.fileHandle, buf.data, buf.lim);
  181.     IF res = buf.lim THEN
  182.       buf.mod := FALSE;
  183.     ELSE
  184.       f.dosError := Dos.base.IoErr ();
  185.     END
  186.   ELSE
  187.     f.dosError := Dos.base.IoErr ();
  188.   END
  189. END WriteBuf;
  190.  
  191.  
  192. (*------------------------------------*)
  193. PROCEDURE GetBuf (f : File; pos : LONGINT) : Buffer;
  194.  
  195.   VAR buf, last, next : Buffer;
  196.  
  197. BEGIN (* GetBuf *)
  198.   buf := f.firstbuf;
  199.   LOOP
  200.     (* ASSERT (buf # NIL, 137); *)
  201.     IF buf.apos = pos THEN EXIT END;
  202.     IF buf.next = f.firstbuf THEN
  203.       last := buf;
  204.       IF f.nofbufs < MaxBufs THEN (* allocate new buffer *)
  205.         NEW (buf);
  206.         (* ASSERT (buf # NIL, 137); *)
  207.         INC (f.nofbufs);
  208.       ELSE (* take one of the buffers (assuming more than one) *)
  209.         buf := f.firstbuf; f.firstbuf := buf.next; last.next := buf.next;
  210.         IF buf.mod THEN WriteBuf (f, buf) END
  211.       END;
  212.       IF pos < f.firstbuf.apos THEN
  213.         f.firstbuf := buf
  214.       ELSIF pos < last.apos THEN
  215.         WHILE last.next.apos < pos DO last := last.next END;
  216.       END;
  217.       buf.next := last.next; last.next := buf;
  218.       buf.apos := pos; buf.lim := 0; buf.mod := FALSE;
  219.       IF pos < f.len THEN ReadBuf (f, buf, pos) END;
  220.       EXIT
  221.     END;
  222.     buf := buf.next
  223.   END; (* LOOP *)
  224.   RETURN buf;
  225. END GetBuf;
  226.  
  227.  
  228. (*------------------------------------*)
  229. PROCEDURE Unbuffer (f : File);
  230.  
  231.   VAR buf : Buffer;
  232.  
  233. BEGIN (* Unbuffer *)
  234.   buf := f.firstbuf;
  235.   REPEAT
  236.     (* ASSERT (buf # NIL, 137); *)
  237.     IF buf.mod THEN WriteBuf (f, buf) END;
  238.     buf := buf.next
  239.   UNTIL buf = f.firstbuf
  240. END Unbuffer;
  241.  
  242.  
  243. (*------------------------------------*)
  244. PROCEDURE MakeTempName (VAR name : ARRAY OF CHAR; key : LONGINT);
  245.  
  246.   VAR i : INTEGER; digit : LONGINT;
  247.  
  248. BEGIN (* MakeTempName *)
  249.   COPY ("T:", name);
  250.   i := 10;
  251.   WHILE i > 0 DO
  252.     digit := key MOD 10H; IF digit >= 10 THEN INC (digit, 7) END;
  253.     DEC (i); name [i] := CHR (digit + ORD ("0")); key := key DIV 10H
  254.   END; (* WHILE *)
  255.   name [10] := 0X; Str.Append (name, ".tmp")
  256. END MakeTempName;
  257.  
  258.  
  259. (* --- Public procedures ------------------------------------------------ *)
  260.  
  261.  
  262. (*------------------------------------*)
  263. (* $D- disable copying of open arrays *)
  264. PROCEDURE Delete * (name : ARRAY OF CHAR; VAR res : LONGINT);
  265.  
  266. BEGIN (* Delete *)
  267.   IF Dos.base.DeleteFile (name) THEN
  268.     res := 0
  269.   ELSE
  270.     res := Dos.base.IoErr ();
  271.     IF res = Dos.errorObjectNotFound THEN res := 0 END
  272.   END; (* ELSE *)
  273. END Delete;
  274.  
  275.  
  276. (*------------------------------------*)
  277. (* $D- disable copying of open arrays *)
  278. PROCEDURE Rename * (old, new : ARRAY OF CHAR; VAR res : LONGINT);
  279.  
  280. BEGIN (* Rename *)
  281.   IF Dos.base.Rename (old, new) THEN
  282.     res := 0
  283.   ELSE
  284.     res := Dos.base.IoErr ()
  285.   END
  286. END Rename;
  287.  
  288.  
  289. (*------------------------------------*)
  290. PROCEDURE Old * (name : ARRAY OF CHAR) : File;
  291. (*
  292.   [TBD]
  293.  
  294.   * This really needs better error handling.  I expect testing will
  295.     force me to provide it :-)
  296.  
  297.   * Implement check for interactive files.
  298. *)
  299.  
  300.   VAR
  301.     f : File; fl : Dos.FileLockPtr; fh : Dos.FileHandlePtr;
  302.     fib : Dos.FileInfoBlockPtr; buf : Buffer;
  303.  
  304. (* $D- disable copying of open arrays *)
  305. BEGIN (* Old *)
  306.   f := NIL;
  307.   fl := Dos.base.Lock (name, Dos.sharedLock);
  308.   IF fl # NIL THEN
  309.     fh := Dos.base.Open (name, Dos.modeOldFile);
  310.     IF fh # NIL THEN
  311.       NEW (fib);
  312.       IF fib # NIL THEN
  313.         IF Dos.base.Examine (fl, fib^) THEN
  314.           Dos.base.UnLock (fl);
  315.           NEW (buf);
  316.           (* ASSERT (buf # NIL, 137); *)
  317.           buf.apos := 0; buf.next := buf; buf.mod := FALSE;
  318.           NEW (f);
  319.           (* ASSERT (f # NIL, 137); *)
  320.           f.len := fib.size;
  321.           Oberon.ADOS2OberonTime (fib.date, f.time, f.date);
  322.           IF f.len > SectorSize THEN buf.lim := SectorSize
  323.           ELSE buf.lim := SHORT (f.len)
  324.           END;
  325.           f.firstbuf := buf; f.nofbufs := 1; f.name [0] := 0X;
  326.           f.fileHandle := fh; f.dosError := 0; f.tempKey := 0;
  327.           f.next := files; files := f;
  328.           ReadBuf (f, buf, 0);
  329.         ELSE
  330.           SYS.PUTREG (0, Dos.base.Close (fh));
  331.         END; (* IF *)
  332.         SYS.DISPOSE (fib);
  333.       ELSE
  334.         SYS.PUTREG (0, Dos.base.Close (fh));
  335.       END; (* IF *)
  336.     END; (* IF *)
  337.   END; (* IF *)
  338.   RETURN f;
  339. END Old;
  340.  
  341. (*------------------------------------*)
  342. PROCEDURE New * (name : ARRAY OF CHAR) : File;
  343. (*
  344.   [TBD]
  345.  
  346.   * This really needs better error handling.  I expect testing will
  347.     force me to provide it :-)
  348.  
  349.   * Implement check for interactive files.
  350. *)
  351.  
  352.   VAR
  353.     tempName : FileName; f : File; fh : Dos.FileHandlePtr; buf : Buffer;
  354.     ch : CHAR; i : INTEGER;
  355.  
  356. (* $D- disable copying of open arrays *)
  357. BEGIN (* New *)
  358.   f := NIL;
  359.   IF name [0] = 0X THEN
  360.     REPEAT MakeTempName (tempName, tempKey); INC (tempKey)
  361.     UNTIL ~DosUtil.FileExists (tempName);
  362.     fh := Dos.base.Open (tempName, Dos.modeNewFile);
  363.   ELSE
  364.     COPY (name, tempName); Str.Append (tempName, "$tmp*");
  365.     i := SHORT (Str.Length (tempName)) - 1; ch := "A";
  366.     REPEAT tempName [i] := ch; ch := CHR (ORD (ch) + 1)
  367.     UNTIL ~DosUtil.FileExists (tempName);
  368.     fh := Dos.base.Open (tempName, Dos.modeNewFile);
  369.   END; (* ELSE *)
  370.   IF fh # NIL THEN
  371.     NEW (buf);
  372.     (* ASSERT (buf # NIL, 137); *)
  373.     buf.apos := 0; buf.next := buf; buf.mod := TRUE; buf.lim := 0;
  374.     NEW (f);
  375.     (* ASSERT (f # NIL, 137); *)
  376.     Oberon.GetClock (f.time, f.date);
  377.     f.len := 0; f.firstbuf := buf; f.nofbufs := 1; COPY (name, f.name);
  378.     f.fileHandle := fh; f.dosError := 0;
  379.     IF name [0] = 0X THEN f.tempKey := tempKey-1
  380.     ELSE f.tempKey := ORD (ch) - 1
  381.     END;
  382.     f.next := files; files := f;
  383.     ReadBuf (f, buf, 0);
  384.   END; (* IF *)
  385.   RETURN f;
  386. END New;
  387.  
  388.  
  389. (*------------------------------------*)
  390. PROCEDURE Register * (f : File);
  391.  
  392.   VAR tempName, bkpName : FileName; i : INTEGER;
  393.  
  394. BEGIN (* Register *)
  395.   IF (f # NIL) & (f.fileHandle # NIL) THEN
  396.     Unlink (f); Unbuffer (f);
  397.     IF Dos.base.Close (f.fileHandle) THEN
  398.       f.dosError := 0;
  399.       IF f.name [0] = 0X THEN
  400.         MakeTempName (tempName, f.tempKey);
  401.         Delete (tempName, f.dosError)
  402.       ELSE
  403.         COPY (f.name, tempName); Str.Append (tempName, "$tmp*");
  404.         i := SHORT (Str.Length (tempName)) - 1;
  405.         tempName [i] := CHR (f.tempKey);
  406.         COPY (f.name, bkpName); Str.Append (bkpName, "$bak");
  407.         Rename (f.name, bkpName, f.dosError);
  408.         IF (f.dosError = 0) THEN
  409.           Rename (tempName, f.name, f.dosError);
  410.           IF f.dosError = 0 THEN
  411.             Delete (bkpName, f.dosError)
  412.           END; (* IF *)
  413.         ELSIF (f.dosError = Dos.errorObjectNotFound) THEN
  414.           Rename (tempName, f.name, f.dosError);
  415.         END; (* IF *)
  416.       END; (* IF *)
  417.     ELSE f.dosError := Dos.base.IoErr ()
  418.     END;
  419.   END; (* IF *)
  420. END Register;
  421.  
  422.  
  423. (*------------------------------------*)
  424. PROCEDURE Close * (f : File);
  425.  
  426. BEGIN (* Close *)
  427.   IF f # NIL THEN
  428.     Unlink (f); Unbuffer (f);
  429.     IF Dos.base.Close (f.fileHandle) THEN f.dosError := 0
  430.     ELSE f.dosError := Dos.base.IoErr ()
  431.     END; (* ELSE *)
  432.   END; (* IF *)
  433. END Close;
  434.  
  435.  
  436. (*------------------------------------*)
  437. PROCEDURE Purge * (f : File);
  438.  
  439.   VAR tempName : FileName; i : INTEGER;
  440.  
  441. BEGIN (* Purge *)
  442.   IF f # NIL THEN
  443.     Unlink (f); Unbuffer (f);
  444.     IF Dos.base.Close (f.fileHandle) THEN
  445.       f.dosError := 0;
  446.       IF f.name [0] = 0X THEN
  447.         MakeTempName (tempName, f.tempKey);
  448.         Delete (tempName, f.dosError)
  449.       ELSE
  450.         COPY (f.name, tempName); Str.Append (tempName, "$tmp*");
  451.         i := SHORT (Str.Length (tempName)) - 1;
  452.         tempName [i] := CHR (f.tempKey);
  453.         Delete (tempName, f.dosError)
  454.       END; (* ELSE *)
  455.     ELSE f.dosError := Dos.base.IoErr ()
  456.     END;
  457.   END; (* IF *)
  458. END Purge;
  459.  
  460.  
  461. (*------------------------------------*)
  462. PROCEDURE Length * (f : File) : LONGINT;
  463.  
  464. BEGIN (* Length *)
  465.   (* ASSERT (f # NIL, 137); *)
  466.   RETURN f.len
  467. END Length;
  468.  
  469.  
  470. (*------------------------------------*)
  471. PROCEDURE GetDate * (f : File; VAR t, d : LONGINT);
  472.  
  473. BEGIN (* GetDate *)
  474.   (* ASSERT (f # NIL, 137); *)
  475.   t := f.time; d := f.date
  476. END GetDate;
  477.  
  478.  
  479. (*------------------------------------*)
  480. PROCEDURE Set * (VAR r : Rider; f : File; pos : LONGINT);
  481.  
  482. BEGIN (* Set *)
  483.   r.eof := FALSE; r.res := 0; r.file := f;
  484.   IF f # NIL THEN
  485.     IF pos < 0 THEN
  486.       r.apos := 0; r.bpos := 0
  487.     ELSE
  488.       r.bpos := SHORT (pos MOD SectorSize); r.apos := pos - r.bpos
  489.     END;
  490.     r.buf := f.firstbuf
  491.   END
  492. END Set;
  493.  
  494.  
  495. (*------------------------------------*)
  496. PROCEDURE Read * (VAR r : Rider; VAR x : SYS.BYTE);
  497.  
  498.   VAR buf : Buffer;
  499.  
  500. BEGIN (* Read *)
  501.   (* ASSERT (r.file # NIL, 137); *)
  502.   (* ASSERT (r.buf # NIL, 137); *)
  503.   IF r.apos # r.buf.apos THEN r.buf := GetBuf (r.file, r.apos) END;
  504.   IF r.bpos < r.buf.lim THEN
  505.     x := r.buf.data [r.bpos]; INC (r.bpos)
  506.   ELSIF (r.apos + SectorSize) < r.file.len THEN
  507.     INC (r.apos, SectorSize);
  508.     r.buf := GetBuf (r.file, r.apos);
  509.     x := r.buf.data [0]; r.bpos := 1
  510.   ELSE
  511.     x := 0X; r.eof := TRUE
  512.   END
  513. END Read;
  514.  
  515.  
  516. (*------------------------------------*)
  517. PROCEDURE ReadBytes *
  518.   ( VAR r : Rider; VAR x : ARRAY OF SYS.BYTE; n : LONGINT);
  519.  
  520.   VAR src, dst, m : LONGINT;
  521.       buf : Buffer;
  522.  
  523. BEGIN (* ReadBytes *)
  524.   (* ASSERT (r.file # NIL, 137); *)
  525.   (* ASSERT (r.buf # NIL, 137); *)
  526.   dst := SYS.VAL (LONGINT, SYS.ADR (x));
  527.   IF LEN (x) < n THEN HALT (25) END;
  528.   IF r.apos # r.buf.apos THEN r.buf := GetBuf (r.file, r.apos) END;
  529.   LOOP
  530.     IF n <= 0 THEN EXIT END;
  531.     src := SYS.VAL (LONGINT, SYS.ADR(r.buf.data));
  532.     INC (src, r.bpos); m := r.bpos + n;
  533.     IF m <= r.buf.lim THEN
  534.       SYS.MOVE (src, dst, n); r.bpos := SHORT (m); r.res := 0;
  535.       EXIT
  536.     ELSIF r.buf.lim = SectorSize THEN
  537.       m := r.buf.lim - r.bpos;
  538.       IF m > 0 THEN
  539.         SYS.MOVE (src, dst, m); INC (dst, m); DEC (n, m)
  540.       END;
  541.       IF r.apos < r.file.len THEN
  542.         INC (r.apos, SectorSize);
  543.         r.bpos := 0; r.buf := GetBuf (r.file, r.apos);
  544.       ELSE
  545.         r.res := n; r.eof := TRUE; EXIT
  546.       END; (* ELSE *)
  547.     ELSE
  548.       m := r.buf.lim - r.bpos;
  549.       IF m > 0 THEN
  550.         SYS.MOVE (src, dst, m); r.bpos := r.buf.lim
  551.       END;
  552.       r.res := n - m; r.eof := TRUE; EXIT
  553.     END; (* ELSE *)
  554.   END; (* LOOP *)
  555. END ReadBytes;
  556.  
  557.  
  558. (*------------------------------------*)
  559. PROCEDURE Write * (VAR r : Rider; x : SYS.BYTE);
  560.  
  561.   VAR f : File; buf : Buffer;
  562.  
  563. BEGIN (* Write *)
  564.   (* ASSERT (r.file # NIL, 137); *)
  565.   (* ASSERT (r.buf # NIL, 137); *)
  566.   IF r.apos # r.buf.apos THEN r.buf := GetBuf (r.file, r.apos) END;
  567.   IF r.bpos >= r.buf.lim THEN
  568.     IF r.bpos < SectorSize THEN
  569.       INC (r.buf.lim); INC (r.file.len)
  570.     ELSE
  571.       f := r.file; INC (r.apos, SectorSize);
  572.       r.buf := GetBuf (f, r.apos);
  573.       IF r.apos >= f.len THEN r.buf.lim := 1; f.len := r.apos END;
  574.       r.bpos := 0
  575.     END
  576.   END;
  577.   r.buf.data [r.bpos] := x; INC (r.bpos); r.buf.mod := TRUE
  578. END Write;
  579.  
  580.  
  581. (*------------------------------------*)
  582. PROCEDURE WriteBytes *
  583.   (VAR r : Rider; VAR x : ARRAY OF SYS.BYTE; n : LONGINT);
  584.  
  585.   VAR src, dst, m : LONGINT; f : File; buf : Buffer;
  586.  
  587. BEGIN (* WriteBytes *)
  588.   (* ASSERT (r.file # NIL, 137); *)
  589.   (* ASSERT (r.buf # NIL, 137); *)
  590.   src := SYS.VAL (LONGINT, SYS.ADR (x));
  591.   IF LEN (x) < n THEN HALT (25) END;
  592.   IF r.apos # r.buf.apos THEN r.buf := GetBuf (r.file, r.apos) END;
  593.   LOOP
  594.     IF n <= 0 THEN EXIT END;
  595.     r.buf.mod := TRUE;
  596.     dst := SYS.VAL (LONGINT, SYS.ADR(r.buf.data)); INC (dst, r.bpos);
  597.     m := r.bpos + n;
  598.     IF m <= r.buf.lim THEN
  599.       SYS.MOVE (src, dst, n); r.bpos := SHORT (m); EXIT
  600.     ELSIF m <= SectorSize THEN
  601.       SYS.MOVE (src, dst, n); r.bpos := SHORT (m);
  602.       INC (r.file.len, n); r.buf.lim := SHORT (m); EXIT
  603.     ELSE
  604.       m := SectorSize - r.bpos;
  605.       IF m > 0 THEN
  606.         SYS.MOVE (src, dst, m); INC (src, m); DEC (n, m);
  607.         INC (r.buf.lim, SHORT (m))
  608.       END;
  609.       f := r.file; INC (r.apos, SectorSize);
  610.       r.bpos := 0; r.buf := GetBuf (f, r.apos);
  611.       IF r.apos >= f.len THEN r.buf.lim := 0; f.len := r.apos END;
  612.     END;
  613.   END; (* LOOP *)
  614. END WriteBytes;
  615.  
  616. (*------------------------------------*)
  617. PROCEDURE Pos * (VAR r : Rider) : LONGINT;
  618.  
  619. BEGIN (* Pos *)
  620.   RETURN r.apos + r.bpos
  621. END Pos;
  622.  
  623.  
  624. (*------------------------------------*)
  625. PROCEDURE Base * (VAR r : Rider) : File;
  626.  
  627. BEGIN (* Base *)
  628.   RETURN r.file;
  629. END Base;
  630.  
  631.  
  632. (*------------------------------------*)
  633. PROCEDURE InitTempKey ();
  634.  
  635.   VAR time, date : LONGINT;
  636.  
  637. BEGIN (* InitTempKey *)
  638.   Oberon.GetClock (time, date); tempKey := date * 10000H + time;
  639.   IF tempKey = 0 THEN INC (tempKey) END
  640. END InitTempKey;
  641.  
  642. (*------------------------------------*)
  643. PROCEDURE* Cleanup ();
  644.  
  645. BEGIN
  646.   WHILE files # NIL DO
  647.     IF files.fileHandle # NIL THEN
  648.       Unbuffer (files); Dos.base.OldClose (files.fileHandle)
  649.     END;
  650.     files := files.next
  651.   END;
  652. END Cleanup;
  653.  
  654. BEGIN
  655.   InitTempKey();
  656.   files := NIL; SYS.SETCLEANUP (Cleanup)
  657. END Files.
  658.  
  659. (***************************************************************************
  660.  
  661.   $Log: Files.mod $
  662.   Revision 1.6  1994/08/08  16:41:14  fjc
  663.   Release 1.4
  664.  
  665.   Revision 1.5  1994/06/14  02:14:31  fjc
  666.   - Updated for release
  667.  
  668.   Revision 1.4  1994/06/09  14:12:41  fjc
  669.   - Incorporated changes to Amiga interface
  670.  
  671.   Revision 1.3  1994/06/04  16:03:39  fjc
  672.   - Changed to use new Amiga interface
  673.  
  674.   Revision 1.2  1994/05/12  20:45:18  fjc
  675.   - Prepared for release
  676.  
  677.   Revision 1.1  1994/01/15  21:39:12  fjc
  678.   Start of revision control
  679.  
  680.   13 Jan 94 [FJC] : Chinged GetBuf to keep buffers in position
  681.                     order, hopefully eliminating seek errors.
  682.                     Now no procedures call ReadBuf or WriteBuf directly.
  683.   28 Dec 93 [FJC] : Actually, I had totally stuffed the handling
  684.                     of temporary files.  *This* time, hopefully,
  685.                     it is fixed.
  686.   15 Dec 93 [FJC] : *Really* fixed handling of temporary files.
  687.    2 Dec 93 [FJC] : Fixed handling of temporary files.
  688.  
  689. ***************************************************************************)
  690.